home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / ANIMAL.ICN < prev    next >
Text File  |  1992-12-30  |  6KB  |  220 lines
  1. ############################################################################
  2. #
  3. #    File:     animal.icn
  4. #
  5. #    Subject:  Program to play ``animal'' guessing game
  6. #
  7. #    Author:   Robert J. Alexander
  8. #
  9. #    Date:     April 25, 1990
  10. #
  11. ###########################################################################
  12. #  
  13. #     This is the familiar ``animal game'' written in Icon.  The
  14. #  program asks its human opponent a series of questions in an attempt
  15. #  to guess what animal he or she is thinking of.  It is an ``expert
  16. #  system'' that starts out with limited knowledge, knowing only one
  17. #  question, but gets smarter as it plays and learns from its opponents.
  18. #  At the conclusion of a session, the program asks permission to
  19. #  remember for future sessions that which it learned.  The saved file
  20. #  is an editable text file, so typos entered during the heat of battle
  21. #  can be corrected.
  22. #  
  23. #     The game is not limited to guessing only animals.  By simply
  24. #  modifying the first two lines of procedure "main" a program can be
  25. #  created that will happily build a knowledge base in other categories.
  26. #  For example, the lines:
  27. #  
  28. #       GameObject := "president"
  29. #       Tree := Question("Has he ever been known as Bonzo",
  30. #          "Reagan","Lincoln")
  31. #  
  32. #  can be substituted, the program works reasonably well, and could even
  33. #  pass as educational.  The knowledge files will automatically be kept
  34. #  separate, too.
  35. #  
  36. #     Typing "list" at any yes/no prompt will show an inventory of
  37. #  animals known, and there are some other commands too (see procedure
  38. #  Confirm).
  39. #  
  40. ############################################################################
  41.  
  42. global GameObject,Tree,Learn
  43. record Question(question,yes,no)
  44.  
  45. #
  46. #  Main procedure.
  47. #
  48. procedure main()
  49.    GameObject := "animal"
  50.    Tree := Question("Does it live in water","goldfish","canary")
  51.    Get()     # Recall prior knowledge
  52.    Game()     # Play a game
  53.    return
  54. end
  55.  
  56. #
  57. #  Game() -- Conducts a game.
  58. #
  59. procedure Game()
  60.    while Confirm("Are you thinking of ",Article(GameObject)," ",GameObject) do
  61.      Ask(Tree)
  62.    write("Thanks for a great game.")
  63.    if \Learn &
  64.      Confirm("Want to save knowledge learned this session") then Save()
  65.    return
  66. end
  67.  
  68. #
  69. #  Confirm() -- Handles yes/no questions and answers.
  70. #
  71. procedure Confirm(q[])
  72.    local answer,s
  73.    static ok
  74.    initial {
  75.       ok := table()
  76.       every ok["y" | "yes" | "yeah" | "uh huh"] := "yes"
  77.       every ok["n" | "no"  | "nope" | "uh uh" ] := "no"
  78.       }
  79.    while /answer do {
  80.       every writes(!q)
  81.       write("?")
  82.       case s := read() | exit(1) of {
  83.      #
  84.      #  Commands recognized at a yes/no prompt.
  85.      #
  86.      "save": Save()
  87.      "get": Get()
  88.      "list": List()
  89.      "dump": Output(Tree)
  90.      default: {
  91.         (answer := \ok[map(s,&ucase,&lcase)]) |
  92.              write("This is a \"yes\" or \"no\" question.")
  93.         }
  94.      }
  95.       }
  96.    return answer == "yes"
  97. end
  98.  
  99. #
  100. #  Ask() -- Navigates through the barrage of questions leading to a
  101. #  guess.
  102. #
  103. procedure Ask(node)
  104.    local guess,question
  105.    case type(node) of {
  106.       "string": {
  107.      if not Confirm("It must be ",Article(node)," ",node,", right") then {
  108.         Learn := "yes"
  109.         write("What were you thinking of?")
  110.         guess := read() | exit(1)
  111.         write("What question would distinguish ",Article(guess)," ",
  112.             guess," from ",Article(node)," ",node,"?")
  113.         question := read() | exit(1)
  114.         if question[-1] == "?" then question[-1] := ""
  115.         question[1] := map(question[1],&lcase,&ucase)
  116.         if Confirm("For ",Article(guess)," ",guess,", what would the _
  117.           answer be") then return Question(question,guess,node)
  118.         else return Question(question,node,guess)
  119.         }
  120.      }
  121.       "Question": {
  122.      if Confirm(node.question) then 
  123.            node.yes := Ask(node.yes)
  124.      else
  125.            node.no := Ask(node.no)
  126.      }
  127.       }
  128. end
  129.  
  130. #
  131. #  Article() -- Come up with the appropriate indefinite article.
  132. #
  133. procedure Article(word)
  134.    return if any('aeiouAEIOU',word) then "an" else "a"
  135. end
  136.  
  137. #
  138. #  Save() -- Store our acquired knowledge in a disk file name
  139. #  based on the GameObject.
  140. #
  141. procedure Save()
  142.    local f
  143.    f := open(GameObject || "s","w")
  144.    Output(Tree,f)
  145.    close(f)
  146.    return
  147. end
  148.  
  149. #
  150. #  Output() -- Recursive procedure used to output the knowledge tree.
  151. #
  152. procedure Output(node,f,sense)
  153.    static indent
  154.    initial indent := 0
  155.    /f := &output
  156.    /sense := " "
  157.    case type(node) of {
  158.       "string":  write(f,repl(" ",indent),sense,"A: ",node)
  159.       "Question": {
  160.      write(f,repl(" ",indent),sense,"Q: ", node.question)
  161.      indent +:= 1
  162.      Output(node.yes,f,"y")
  163.      Output(node.no,f,"n")
  164.      indent -:= 1
  165.      }
  166.       }
  167.    return
  168. end
  169.  
  170. #
  171. #  Get() -- Read in a knowledge base from a disk file.
  172. #
  173. procedure Get()
  174.    local f
  175.    f := open(GameObject || "s","r") | fail
  176.    Tree := Input(f)
  177.    close(f)
  178.    return
  179. end
  180.  
  181. #
  182. #  Input() -- Recursive procedure used to input the knowledge tree.
  183. #
  184. procedure Input(f)
  185.    local nodetype,s
  186.    read(f) ? (tab(upto(~' \t')) & =("y" | "n" | "") &
  187.      nodetype := move(1) & move(2) & s := tab(0))
  188.    return if nodetype == "Q" then Question(s,Input(f),Input(f)) else s
  189. end
  190.  
  191. #
  192. #  List() -- Lists the objects in the knowledge base.
  193. #
  194. procedure List()
  195.    local lst,line,item
  196.    lst := Show(Tree,[])
  197.    line := ""
  198.    every item := !sort(lst) do {
  199.       if *line + *item > 78 then {
  200.      write(trim(line))
  201.      line := ""
  202.      }
  203.       line ||:= item || ", "
  204.       }
  205.    write(line[1:-2])
  206.    return
  207. end
  208.  
  209. #
  210. #  Show() -- Recursive procedure used to navigate the knowledge tree.
  211. #
  212. procedure Show(node,lst)
  213.    if type(node) == "Question" then {
  214.       lst := Show(node.yes,lst)
  215.       lst := Show(node.no,lst)
  216.       }
  217.    else put(lst,node)
  218.    return lst
  219. end
  220.